home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bbanswer.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-02-16  |  15.4 KB  |  450 lines
  1. (*===========================================================================*)
  2. (* Answer telephone                                                          *)
  3. (*                                                                           *)
  4. (*   Copyright 1989, 1990, 1991 by H. Roy Engehausen.  All rights reserved.  *)
  5. (*                                                                           *)
  6. (*===========================================================================*)
  7.  
  8. {$O+}
  9.  
  10. UNIT BBANSWER;
  11.  
  12. INTERFACE
  13.  
  14.   USES
  15.     bbdummy;
  16.  
  17.   PROCEDURE answer_modem;
  18.   PROCEDURE connect_speed(s : str8);
  19.  
  20. IMPLEMENTATION
  21.  
  22.   USES
  23.     DOS,
  24.     bbauxm,
  25.     bbmdata,
  26.     bbmess,
  27.     bbmisc5,
  28.     bbrdata,
  29.     bbsdata,
  30.     bbsess,
  31.     bbsrt,
  32.     bbstr,
  33.     bbtask,
  34.     bbtime,
  35.     bbtrace,
  36.     bbuf,
  37.     bbwin;
  38.  
  39.   {$UNDEF DEBUG_1}
  40.  
  41.   PROCEDURE answer_modem;
  42.  
  43.     CONST
  44.       time_out_other    = 6;
  45.       time_out_password = 10;
  46.       time_out_carrier  = 255;
  47.  
  48.     VAR
  49.       b             : BOOLEAN;
  50.       connect_call  : call_sign_str;
  51.       i             : INTEGER;
  52.       p             : STRING[4];
  53.       s             : STRING;
  54.       uid_i_current : user_index_ptr;
  55.  
  56.     (*=======================================================================*)
  57.     (* Get something from TNC                                                *)
  58.     (*=======================================================================*)
  59.  
  60.     PROCEDURE get_something;
  61.  
  62.       BEGIN;
  63.  
  64.         s := read_tnc_data_str;
  65.  
  66.         {$IFDEF DEBUG_1}
  67.           trace_data('ANS1', LENGTH(s), NIL, s);
  68.         {$ENDIF}
  69.  
  70.         IF s = '' THEN
  71.           BEGIN;
  72.             p[3] := 'T';
  73.             window_write(p, 'Timeout on modem');
  74.  
  75.             cmd_tnc(@disc_cmd, TRUE);
  76.  
  77.             task_destroy_active;
  78.           END;
  79.  
  80.         (*-------------------------------------------------------------------*)
  81.         (* Strip leading garbage, trailing LF and upcase it                  *)
  82.         (*-------------------------------------------------------------------*)
  83.  
  84.         WHILE (LENGTH(s) > 0) AND ((s[1] <= #$20) OR (s[1] >= #$80)) DO
  85.           s := COPY(s, 2, 255);
  86.  
  87.         strip_crlf(s);
  88.         upcase_str_var(s);
  89.  
  90.         {$IFDEF DEBUG_1}
  91.           trace_data('ANS4', LENGTH(s), NIL, s);
  92.         {$ENDIF}
  93.  
  94.         (*-------------------------------------------------------------------*)
  95.         (* Check for magic NO CARRIER word                                   *)
  96.         (*-------------------------------------------------------------------*)
  97.  
  98.         IF s = no_carrier THEN
  99.           BEGIN;
  100.             cmd_tnc(@disc_cmd, TRUE);
  101.             task_destroy_active;
  102.           END;
  103.  
  104.       END;
  105.  
  106.     PROCEDURE answer_phone;
  107.       BEGIN;
  108.  
  109.         send_tnc_data_str('ATA' + cr);
  110.  
  111.         send_flush;
  112.  
  113.       END;
  114.  
  115.     (*=======================================================================*)
  116.     (* Main line of BBANSWER                                                 *)
  117.     (*=======================================================================*)
  118.  
  119.     BEGIN;
  120.  
  121.       (*---------------------------------------------------------------------*)
  122.       (* Set time out                                                        *)
  123.       (*---------------------------------------------------------------------*)
  124.  
  125.       active_port^.cr_timeout := time_out_other;
  126.  
  127.       (*---------------------------------------------------------------------*)
  128.       (* Change task type                                                    *)
  129.       (*---------------------------------------------------------------------*)
  130.  
  131.       active_tcb^.tcb_type := th_answer;
  132.  
  133.       (*---------------------------------------------------------------------*)
  134.       (* Add CRLF unless told otherwise                                      *)
  135.       (*---------------------------------------------------------------------*)
  136.  
  137.       active_port^.modem_crlf := TRUE;
  138.  
  139.       (*---------------------------------------------------------------------*)
  140.       (* Initial task display                                                *)
  141.       (*---------------------------------------------------------------------*)
  142.  
  143.       STR(active_port^.com_number, p);
  144.       active_tcb^.tcb_name := 'COM' + p;
  145.  
  146.       (*---------------------------------------------------------------------*)
  147.       (* Switch window to connect                                            *)
  148.       (*---------------------------------------------------------------------*)
  149.  
  150.       active_tcb^.window  := window_connect;
  151.  
  152.       (*---------------------------------------------------------------------*)
  153.       (* Need to fake maxpac                                                 *)
  154.       (*---------------------------------------------------------------------*)
  155.  
  156.       active_tcb^.max_pac := 250;
  157.  
  158.       (*---------------------------------------------------------------------*)
  159.       (* Initialize prefix                                                   *)
  160.       (*---------------------------------------------------------------------*)
  161.  
  162.       p := active_tcb^.port_chan_s + ' :';
  163.  
  164.       (*---------------------------------------------------------------------*)
  165.       (* Tell LC to ignore                                                   *)
  166.       (*---------------------------------------------------------------------*)
  167.  
  168.       active_tcb^.tcb_ignore_lc := TRUE;
  169.  
  170.       (*---------------------------------------------------------------------*)
  171.       (* Garbage collect                                                     *)
  172.       (*---------------------------------------------------------------------*)
  173.  
  174.       gc;
  175.  
  176.       (*---------------------------------------------------------------------*)
  177.       (* Delay                                                               *)
  178.       (*---------------------------------------------------------------------*)
  179.  
  180.       FOR i := 1 TO 8 DO
  181.         task_switch;
  182.  
  183.       (*---------------------------------------------------------------------*)
  184.       (* Loop for right number of rings                                      *)
  185.       (*---------------------------------------------------------------------*)
  186.  
  187.       i := 1;
  188.  
  189.       WHILE i < active_port^.answer_ring DO
  190.         BEGIN;
  191.  
  192.           get_something;
  193.  
  194.           IF s = ring THEN
  195.             INC(i);
  196.  
  197.           {$IFDEF DEBUG_1}
  198.             trace_data('ANS5', i, NIL, s);
  199.           {$ENDIF}
  200.  
  201.         END;
  202.  
  203.       (*---------------------------------------------------------------------*)
  204.       (* Answer phone                                                        *)
  205.       (*---------------------------------------------------------------------*)
  206.  
  207.       answer_phone;
  208.  
  209.       (*---------------------------------------------------------------------*)
  210.       (* Set timeouts for answer                                             *)
  211.       (*---------------------------------------------------------------------*)
  212.  
  213.       active_port^.cr_timeout := time_out_carrier;
  214.  
  215.       (*---------------------------------------------------------------------*)
  216.       (* Delay                                                               *)
  217.       (*---------------------------------------------------------------------*)
  218.  
  219.       FOR i := 1 TO 8 DO
  220.         task_switch;
  221.  
  222.       (*---------------------------------------------------------------------*)
  223.       (* Loop looking for CONNECT message from TNC                           *)
  224.       (*---------------------------------------------------------------------*)
  225.  
  226.       REPEAT
  227.  
  228.         get_something;
  229.  
  230.         IF s = ring THEN
  231.           answer_phone;
  232.  
  233.         i := words(s);
  234.  
  235.         {$IFDEF DEBUG_1}
  236.           trace_data('ANS6', i, NIL, s);
  237.         {$ENDIF}
  238.  
  239.       UNTIL (i <= 2) AND (subword(@s, 1, 1) = connect);
  240.  
  241.       (*---------------------------------------------------------------------*)
  242.       (* Set modem speed                                                     *)
  243.       (*---------------------------------------------------------------------*)
  244.  
  245.       s := subword(@s, 2, 1);
  246.       connect_speed(s);
  247.  
  248.       (*---------------------------------------------------------------------*)
  249.       (* Stop ignoring lc                                                    *)
  250.       (*---------------------------------------------------------------------*)
  251.  
  252.       active_tcb^.tcb_ignore_lc := FALSE;
  253.  
  254.       (*---------------------------------------------------------------------*)
  255.       (* Now that we are connected, set longer time out                      *)
  256.       (*---------------------------------------------------------------------*)
  257.  
  258.       active_port^.cr_timeout := time_out_password;
  259.  
  260.       (*---------------------------------------------------------------------*)
  261.       (* If port is locked then tell him and hang up                         *)
  262.       (*---------------------------------------------------------------------*)
  263.  
  264.       IF active_port^.port_operate_mode.mode_stop_connect
  265.                                OR opt_block.operate_mode.mode_stop_connect THEN
  266.         BEGIN;
  267.           send_message(message_port_conn_off);
  268.           end_session(TRUE);
  269.         END;
  270.  
  271.       (*---------------------------------------------------------------------*)
  272.       (* Ask for userid                                                      *)
  273.       (*---------------------------------------------------------------------*)
  274.  
  275.       b := FALSE;
  276.  
  277.       REPEAT
  278.  
  279.         send_message(message_enter_uid);
  280.         send_flush;
  281.  
  282.         get_something;
  283.  
  284.         i := words(s);
  285.         IF (i = 1) AND (LENGTH(s) <= call_sign_len) THEN
  286.           b := TRUE;
  287.  
  288.       UNTIL b;
  289.  
  290.       connect_call := s;
  291.  
  292.       {$IFDEF DEBUG_1}
  293.         trace_data('ANS7', LENGTH(s), NIL, s);
  294.       {$ENDIF}
  295.  
  296.       (*---------------------------------------------------------------------*)
  297.       (* Find user                                                           *)
  298.       (*---------------------------------------------------------------------*)
  299.  
  300.       uid_i_current := find_uid(connect_call);
  301.  
  302.       IF uid_i_current <> NIL THEN
  303.         active_tcb^.uid_data := get_uid(uid_i_current)^;
  304.  
  305.       (*---------------------------------------------------------------------*)
  306.       (* Ask for password                                                    *)
  307.       (*---------------------------------------------------------------------*)
  308.  
  309.       i := 0;
  310.       b := FALSE;
  311.  
  312.       REPEAT
  313.  
  314.         (*-------------------------------------------------------------------*)
  315.         (* Bump retry count                                                  *)
  316.         (*-------------------------------------------------------------------*)
  317.  
  318.         INC(i);
  319.  
  320.         (*-------------------------------------------------------------------*)
  321.         (* Loop until something arrives                                      *)
  322.         (*-------------------------------------------------------------------*)
  323.  
  324.         REPEAT
  325.  
  326.           send_message(message_enter_password);
  327.           send_flush;
  328.  
  329.           get_something;
  330.  
  331.         UNTIL s <> '';
  332.  
  333.         (*-------------------------------------------------------------------*)
  334.         (* Bad user?                                                         *)
  335.         (*-------------------------------------------------------------------*)
  336.  
  337.         IF uid_i_current = NIL THEN
  338.           BEGIN;
  339.             send_message(message_not_on_port);
  340.             end_session(TRUE);
  341.           END;
  342.  
  343.         (*-------------------------------------------------------------------*)
  344.         (* Check password                                                    *)
  345.         (*-------------------------------------------------------------------*)
  346.  
  347.         b := active_tcb^.uid_data.user_pw = s;
  348.  
  349.         (*-------------------------------------------------------------------*)
  350.         (* Loop until password OK or retires exhausted                       *)
  351.         (*-------------------------------------------------------------------*)
  352.  
  353.       UNTIL b OR (i > 2);
  354.  
  355.       (*---------------------------------------------------------------------*)
  356.       (* Unsuccessful logon                                                  *)
  357.       (*---------------------------------------------------------------------*)
  358.  
  359.       IF NOT b THEN
  360.         BEGIN;
  361.           send_message(message_not_on_port);
  362.           end_session(TRUE);
  363.         END;
  364.  
  365.       (*---------------------------------------------------------------------*)
  366.       (* Now that we are fully on, reset timeouts                            *)
  367.       (*---------------------------------------------------------------------*)
  368.  
  369.       active_port^.cr_timeout := 0;
  370.  
  371.       (*---------------------------------------------------------------------*)
  372.       (* Fake a monitor connect                                              *)
  373.       (*---------------------------------------------------------------------*)
  374.  
  375.       add_mon_call(active_port, active_port^.port_char, connect_call);
  376.  
  377.       (*---------------------------------------------------------------------*)
  378.       (* Now we fake a connect record from the user                          *)
  379.       (*---------------------------------------------------------------------*)
  380.  
  381.       active_tcb^.tnc_data.str_data    := t_to_h_ct + connect_call;
  382.       active_tcb^.tnc_data.long_length :=
  383.                                         LENGTH(active_tcb^.tnc_data.str_data);
  384.  
  385.       active_tcb^.tnc_type := t_to_h_links;
  386.       active_tcb^.tnc_null := FALSE;
  387.  
  388.       active_tcb^.tcb_name := connect_call;
  389.  
  390.       status_window_change := TRUE;
  391.  
  392.     END;
  393.  
  394. (*===========================================================================*)
  395. (* Handle the connect speed                                                  *)
  396. (*===========================================================================*)
  397.  
  398. PROCEDURE connect_speed(s : str8);
  399.  
  400.   VAR
  401.     i     : WORD;
  402.     p     : STRING[4];
  403.     speed : WORD;
  404.  
  405.   BEGIN;
  406.  
  407.     (*-----------------------------------------------------------------------*)
  408.     (* Determine modem speed                                                 *)
  409.     (*-----------------------------------------------------------------------*)
  410.  
  411.     IF s = '' THEN
  412.       speed := 300
  413.     ELSE
  414.       BEGIN;
  415.  
  416.         VAL(s, speed, i);
  417.         IF i <> 0 THEN
  418.           BEGIN;
  419.             p := active_tcb^.port_chan_s + 'E:';
  420.             window_write_critical(p, 'Non numeric speed setting');
  421.             cmd_tnc(@disc_cmd, TRUE);
  422.             task_destroy_active;
  423.           END;
  424.  
  425.       END;
  426.  
  427.     (*-----------------------------------------------------------------------*)
  428.     (* Set speed if this is allowed                                          *)
  429.     (*-----------------------------------------------------------------------*)
  430.  
  431.     IF NOT active_port^.modem_freez THEN
  432.       set_port_speed(speed);
  433.  
  434.     (*-----------------------------------------------------------------------*)
  435.     (* Wait for things to settle                                             *)
  436.     (*-----------------------------------------------------------------------*)
  437.  
  438.     task_wait(5, FALSE);
  439.  
  440.     (*-----------------------------------------------------------------------*)
  441.     (* Pop any waiting things off the stack                                  *)
  442.     (*-----------------------------------------------------------------------*)
  443.  
  444.     FOR speed := 1 TO 10 DO
  445.       i := send_pending(TRUE);
  446.  
  447.   END;
  448.  
  449. END.
  450.